home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / music / stk100.zip / PLAYDWD.BAS < prev    next >
BASIC Source File  |  1995-01-12  |  11KB  |  335 lines
  1. '******************************************************************************
  2. 'FILE:      playdwd.bas
  3. 'Tab stops: every 2 collumns
  4. 'Project:   DWD Player
  5. 'Copyright: 1994 DiamondWare, Ltd.  All rights reserved.*
  6. 'Written:   Erik Lorenzen & Don Lemmons
  7. 'Purpose:   Contains simple example code to show how to load/play a .DWD file
  8. 'History:   KW 10/21/94 Started playdwd.c
  9. '           DL 11/12/94 Translated to BASIC
  10. '           EL 01/12/95 Cleaned up & Finalized
  11. '
  12. 'Notes
  13. '-----
  14. '
  15. 'The bulk of this file is error checking logic.
  16. '
  17. 'However, this code isn't really robust when it comes to standard error checking
  18. 'and particularly recovery, software engineering technique, etc.  A buffer of
  19. 'size 32767 is statically allocated.  A better technique would be to
  20. 'determine the file's size.  The STK will handle songs larger than 64K
  21. '(but not digitized sounds). Also, exitting and cleanup is not handled
  22. 'robustly in this code.  The code below can only be validated by
  23. 'extremely careful scrutiny to make sure each case is handled properly.
  24. '
  25. 'But all such code would make this example file less clear; its purpose was
  26. 'to illustrate how to call the STK, not how to write QA-proof software.
  27. '
  28. '
  29. '*Permission is expressely granted to use DisplayError or any derivitive made
  30. ' from it to registered users of the STK.
  31. '******************************************************************************/
  32.  
  33.  
  34.  
  35. '$INCLUDE: 'dws.bi'
  36.  
  37.  
  38.  
  39. TYPE BUFFTYP
  40.     buf AS STRING * 32767
  41. END TYPE
  42.  
  43.  
  44.  
  45. 'DECLARE VARIABLES
  46.     COMMON SHARED dov     AS dwsDETECTOVERRIDES
  47.     COMMON SHARED dres    AS dwsDETECTRESULTS
  48.     COMMON SHARED ideal AS dwsIDEAL
  49.     COMMON SHARED dplay AS dwsDPLAY
  50.  
  51.  
  52.  
  53. DIM SHARED buffer(0) AS BUFFTYP 'set aside string area for song to load into
  54.                                                                 'by doing it this way we give QBasic the
  55.                                                                 'opportunity to place the song into far mem
  56.  
  57.  
  58.  
  59. SUB DisplayError(errornum)
  60.     SELECT CASE errornum
  61.  
  62.         CASE dwsEZERO
  63.             'This should not have happened, considering how we got here!
  64.             PRINT"I'm confused!  Where am I?  HOW DID I GET HERE????"
  65.             PRINT "The ERROR number is:";errornum
  66.  
  67.         CASE dwsNOTINITTED
  68.             'If we get here, it means you haven't called dwsInit().
  69.             'The STK needs to initialize itself and the hardware before
  70.             'it can do anything.
  71.             PRINT"The STK was not initialized"
  72.  
  73.         CASE dwsALREADYINITTED
  74.             'If we get here, it means you've called dwsInit() already.    Calling
  75.             'dwsDetectHardWare() at this point would cause zillions of
  76.             'problems if we let the call through.
  77.             PRINT"The STK was already initialized"
  78.  
  79.         CASE dwsNOTSUPPORTED:
  80.             'If we get here, it means that either the user's machine does not
  81.             'support the function you just called, or the STK was told not to
  82.             'support it in dwsInit.
  83.             PRINT"Function not supported"
  84.  
  85.         CASE dwsDetectHardwareUNSTABLESYSTEM
  86.             ' Please report it to DiamondWare if you get here!
  87.             '
  88.             ' Ideally, you would disable control-C here, so that the user can't
  89.             ' hit control-alt-delete, causing SmartDrive to flush its (possibly
  90.             ' currupt) buffers.
  91.             PRINT"The system is unstable!"
  92.             PRINT"Please power down now!"
  93.  
  94.             AGAIN:
  95.             GOTO AGAIN
  96.  
  97.         'The following three errors are USER/PROGRAMMER errors.  You forgot
  98.         'to fill the cardtyp struct full of -1's (except in those fields
  99.         'you intended to override, or the user (upon the unlikly event that
  100.         'the STK was unable to find a card) gave you a bad overide value.
  101.  
  102.         CASE dwsDetectHardwareBADBASEPORT
  103.             'You set dov.baseport to a bad value, or
  104.             'didn't fill it with a -1.
  105.             PRINT"Bad port address"
  106.  
  107.         CASE dwsDetectHardwareBADDMA
  108.             'You set dov.digdma to a bad value, or
  109.             'didn't fill it with a -1.
  110.             PRINT"Bad DMA channel"
  111.  
  112.         CASE dwsDetectHardwareBADIRQ
  113.             'You set dov.digirq to a bad value, or
  114.             'didn't fill it with a -1.
  115.             PRINT"Bad IRQ level"
  116.  
  117.         CASE dwsKillCANTUNHOOKISR
  118.             'The STK points the interrupt vector for the sound card's IRQ
  119.             'to its own code in dws_Init.
  120.             '
  121.             'dws_Kill was unable to restore the vector to its original
  122.             'value because other code has hooked it after the STK
  123.             'initialized(!)  This is really bad.  Make the user get rid
  124.             'of it and call dws_Kill again.
  125.  
  126.             PRINT"Get rid of your TSR, pal!"
  127.             INPUT"(Hit ENTER when ready)";g$
  128.  
  129.         CASE dwsXBADINPUT
  130.             'The mixer funtion's can only accept volumes between 0 & 255,
  131.             'the volume will remain unchanged.
  132.  
  133.             PRINT"Bad mixer level"
  134.  
  135.         CASE dwsDNOTADWD
  136.             'You passed the STK a pointer to something which is not a .DWD file!
  137.             PRINT"The file you are attempting to play is not a .DWD"
  138.  
  139.         CASE dwsDNOTSUPPORTEDVER
  140.             'The STK can't play a .DWD converted using a version of VOC2DWD.EXE
  141.             'newer than itself.  And, although we'll try to maintain backwards
  142.             'compatibility, we may not be able to guarantee that newer versions
  143.             'of the code will be able to play older .DWD files.  In any event,
  144.             'it's a good idea to always convert .VOC files with the utility
  145.             'which comes with the library you're linking into your application.
  146.             PRINT"Please reconvert this file using the VOC2DWD program which came with this library"
  147.  
  148.         CASE dwsDINTERNALERROR
  149.             'This error should never occur and probably will not affect sound
  150.             'play(?). If it happens please contact DiamondWare.
  151.             PRINT"An internal error has occured"
  152.             PRINT"Please contact DiamondWare"
  153.  
  154.         CASE dwsDPlayNOSPACEFORSOUND
  155.             'This error is more like a warning, though it may happen on a
  156.             'regular basis, depending on how many sounds you told the STK
  157.             'to allow in dws_Init, how you chose to prioritize sounds and
  158.             'how many sounds are currently being played.
  159.             PRINT"No more room for new digitized sounds right now"
  160.  
  161.         CASE dwsDSetRateFREQTOLOW
  162.             'The STK will set rate as close as possible to the indicated rate
  163.             'but cannot set a rate that low.
  164.             PRINT"Playback frequency too low"
  165.  
  166.         CASE dwsDSetRateFREQTOHIGH
  167.             'The STK will set rate as close as possible to the indicated rate
  168.             'but cannot set a rate that high.
  169.             PRINT"Playback frequency too high"
  170.  
  171.         CASE dwsMPlayNOTADWM
  172.             'You passed the STK a pointer to something which is not a .DWM file!
  173.             PRINT"The file you are attempting to play is not a .DWM"
  174.  
  175.         CASE dwsMPlayNOTSUPPORTEDVER
  176.             'The STK can't play a .DWM converted using a version of VOC2DWM.EXE
  177.             'newer than itself.  And, although we'll try to maintain backwards
  178.             'compatibility, we may not be able to guarantee that newer versions
  179.             'of the code will be able to play older .DWM files.  In any event,
  180.             'it's a good idea to always convert .MID files with the utility
  181.             'which comes with the library you're linking into your application.
  182.             PRINT"Please reconvert this file using the MID2DWM.EXE which came with this library";
  183.  
  184.         CASE dwsMPlayINTERNALERROR:
  185.             'This error should never occur and probably will not affect sound
  186.             'play(?). If it happens please contact DiamondWare.
  187.             PRINT"An internal error has occured.  Please contact DiamondWare."
  188.  
  189.         CASE ELSE
  190.             'This should never occur and probably will not affect sound
  191.             'play(?). If it happens please contact DiamondWare.
  192.             PRINT"I'm confused!  Where am I?  HOW DID I GET HERE????"
  193.             PRINT "The ERROR number is:";errornum
  194.  
  195.     END SELECT
  196.  
  197. END SUB
  198.  
  199.  
  200.  
  201. 'START OF MAIN
  202.  
  203.     PRINT
  204.     PRINT "PLAYDWD is Copyright 1994, DiamondWare, Ltd."
  205.     PRINT "All rights reserved."
  206.     PRINT : PRINT : PRINT
  207.  
  208.     filename$ = LTRIM$(RTRIM$(COMMAND$))
  209.     IF filename$ = "" THEN
  210.         PRINT "Usage PLAYDWD <dwd-file>"
  211.         GOTO ProgramExit
  212.     END IF
  213.  
  214.     'get the file length
  215.     IF INSTR(filename$, ".DWD") = 0 THEN filename$ = ".DWD"
  216.  
  217.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  218.     filelen = LOF(1)
  219.     CLOSE #1
  220.  
  221.     IF filelen = 0 THEN
  222.         PRINT "File Not Found"
  223.         GOTO ProgramExit
  224.     END IF
  225.  
  226.     IF filelen > 32767 THEN
  227.         PRINT "File Too Big"
  228.         GOTO ProgramExit
  229.     END IF
  230.  
  231.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  232.     GET #1, 1, buffer(0).buf
  233.     CLOSE #1
  234.  
  235.     'We need to set every field to -1 in dwsDETECTOVERRIDES struct; this
  236.     'tells the STK to autodetect everything.  Any other value
  237.     'overrides the autodetect routine, and will be accepted on
  238.     'faith, though the STK will verify it if possible.
  239.  
  240.     dov.baseport = -1
  241.     dov.digdma     = -1
  242.     dov.digirq     = -1
  243.  
  244.     IF DWSDetectHardWare(dov, dres) = 0 THEN
  245.         errnum = dwsErrNo
  246.         DisplayError(errnum)
  247.         GOTO ProgramExit
  248.     END IF
  249.  
  250.     IF (dres.capability AND dwscapabilityDIG) <> dwscapabilityDIG THEN
  251.         PRINT"DIG support not found"
  252.         GOTO ProgramExit
  253.     END IF
  254.  
  255.     'The "ideal" struct tells the STK how you'd like it to initialize the
  256.     'sound hardware.  In all cases, if the hardware won't support your     r
  257.     'request, the STK will go as close as possible.  For example, not all
  258.     'sound boards will support al sampling rates (some only support 5 or
  259.     '6 discrete rates).
  260.  
  261.     ideal.musictyp     = 0         '0=No music, 1=OPL2
  262.     ideal.digtyp         = 8         '0=No Dig, 8=8bit
  263.     ideal.digrate      = 5000  'sampling rate, in Hz
  264.                                                      'we could have called dws_DGetRateFromDWD
  265.                                                      'before initing the STK to get the correct rate
  266.     ideal.dignvoices = 16      'number of voices (up to 16)
  267.     ideal.dignchan     = 1         '1=mono
  268.  
  269.     IF dwsInit(dres, ideal) = 0 THEN
  270.         errnum = dwsErrNo
  271.         DisplayError(errnum)
  272.         GOTO ProgramKill
  273.     END IF
  274.  
  275.     'Set master vol to about 4/5ths of max
  276.     IF dwsXMaster(200) = 0 THEN
  277.         errnum = dwsErrNo
  278.         DisplayError(errnum)
  279.     END IF
  280.  
  281.     soundseg% = VARSEG(buffer(0).buf)
  282.     soundoff% = VARPTR(buffer(0).buf)
  283.     pointer&    = soundseg% * 256 ^ 2 + soundoff%  'make pointer
  284.  
  285.     dplay.snd          = pointer&
  286.     dplay.count      = 1                '0=infinite loop, 1-N num times to play sound
  287.     dplay.priority = 1000
  288.     dplay.presnd     = 0
  289.  
  290.     IF dwsDGetRateFromDWD(pointer&, ideal.digrate) = 0 THEN
  291.         errnum = dwsErrNo
  292.         DisplayError(errnum)
  293.         GOTO ProgramKill
  294.     END IF
  295.  
  296.     IF dwsDSetRate(ideal.digrate)  = 0 THEN
  297.         errnum = dwsErrNo
  298.         DisplayError(errnum)
  299.         GOTO ProgramKill
  300.     END IF
  301.  
  302.     IF dwsDPlay(dplay)    = 0 THEN
  303.         errnum = dwsErrNo
  304.         DisplayError(errnum)
  305.         GOTO ProgramKill
  306.     END IF
  307.  
  308.     result% = dwsDSOUNDSTATUSPLAYING
  309.     DO UNTIL (result%  AND dwsDSOUNDSTATUSPLAYING) <> dwsDSOUNDSTATUSPLAYING
  310.         IF dwsDSoundStatus(dplay.soundnum, result%) = 0 THEN
  311.             errnum = dwsErrNo
  312.             DisplayError(errnum)
  313.             GOTO ProgramKill
  314.         END IF
  315.     LOOP
  316.  
  317.     ProgramKill:
  318.  
  319.     IF dwsKill = 0 THEN
  320.         errnum = dwsErrNo
  321.         DisplayError(errnum)
  322.  
  323.         'If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  324.         'or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  325.         'must remove his tsr, and dws_Kill must be called again.  If it's
  326.         'dws_NOTINITTED, there's nothing to worry about at this point.
  327.         IF errnum = dwsKillCANTUNHOOKISR THEN
  328.             GOTO ProgramKill
  329.         END IF
  330.     END IF
  331.  
  332.     ProgramExit:
  333.  
  334. END
  335.